home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / STRINGS.SWG / 0043_Convert Long to HEX Str.pas < prev    next >
Pascal/Delphi Source File  |  1993-09-26  |  4KB  |  128 lines
  1. (*
  2. ===========================================================================
  3.  BBS: Canada Remote Systems
  4. Date: 09-16-93 (08:30)             Number: 27395
  5. From: HELGE HELGESEN               Refer#: NONE
  6.   To: KURTIS LINDQVIST              Recvd: NO
  7. Subj: Longint to HEX                 Conf: (552) R-TP
  8. ---------------------------------------------------------------------------
  9. Here's a simple - unoptimized - function to convert a
  10. longint to hex.
  11. *)
  12. function LongInt2Str(no: longint): string; assembler;
  13. const
  14.   Digits: array[0..$f] of char =
  15.     ( '0', '1', '2', '3', '4' ,'5', '6', '7', '8', '9', 'A', 'B', 'C',
  16.       'D', 'E', 'F'
  17.     );
  18. asm
  19.   les  di, @Result { get address to result }
  20.   mov  al, 8 { size of result }
  21.   stosb
  22.   lea  bx, Digits { get adress to digit table }
  23.   mov  dx, word ptr no+2
  24.   mov  cx, 2
  25. @1:
  26.   mov  al, dh
  27.   shr  al, 4
  28.   xlat
  29.   stosb
  30.   mov  al, dh
  31.   and  al, 15
  32.   xlat
  33.   stosb
  34.   mov  al, dl
  35.   shr  al, 4
  36.   xlat
  37.   stosb
  38.   mov  al, dl
  39.   and  al, 15
  40.   xlat
  41.   stosb
  42.   mov  dx, word ptr no
  43.   loop @1
  44. end;
  45. ---
  46.  ■ RM 1.2 00308 ■ C program run.  C program crash.  C programmer quit
  47.  * Midnight Sun BBS, Norway +47 81 84545 HST/DS, 9 Gb
  48.  * PostLink(tm) v1.07  MIDNIGHT (#602) : RelayNet(tm)
  49. ===========================================================================
  50.  BBS: Canada Remote Systems
  51. Date: 09-16-93 (20:19)             Number: 27393
  52. From: PHIL NICKELL                 Refer#: NONE
  53.   To: KURTIS LINDQVIST              Recvd: NO
  54. Subj: Longint to HEX                 Conf: (552) R-TP
  55. ---------------------------------------------------------------------------
  56. KL│Allright, I have been struggling with this problem for awhile but I give up.
  57.   │A friend of mine wrote a unit that would convert a longint to a HEX number in
  58.   │string. This is for a program that stores one file for each user (it's an ord
  59.   │door), the name of the file is equal to the HEX number representing the
  60.  
  61.  I'll include two functions named HEXLONG that produce identical
  62.  results.  The first is pure classic Turbo Pascal, the second is a Turbo
  63.  Pascal Assembler function that is blinding-speed vs size optimized.
  64.  You pass them a longint value, they return an 8 byte string.  Voila.
  65.  Take your pick.
  66.  
  67.  
  68. (* Return a 8 byte ascii string of the hex value of the longint
  69.    argument *)
  70. FUNCTION  Hexlong (argument : longint): namestr;
  71.    var i      :longint;
  72.        res    :namestr;
  73.    Const
  74.        HexTable  :array[0..15] of char = '0123456789ABCDEF';
  75.   begin
  76.     res[0] := #8;
  77.     for i := 0 to 7 do
  78.       res[8-i] := HexTable[ argument shr (i shl 2) and $f];
  79.     hexlong := res;
  80.   end;
  81.  
  82. FUNCTION  Hexlong (argument : longint): namestr; Assembler;
  83.   asm
  84.      cld
  85.      les    di,@result
  86.      mov    al,8                   { store string length }
  87.      stosb
  88.      mov    cl, 4                  { shift count }
  89.  
  90.      mov    dx,Word Ptr Argument+2 { hi word }
  91.      call   @1                     { convert dh to ascii }
  92.      mov    dh, dl                 { lo byte of hi word }
  93.      call   @1                     { convert dh to ascii }
  94.      mov    dx,Word Ptr Argument   { lo word }
  95.      call   @1                     { convert dh to ascii }
  96.      mov    dh, dl                 { lo byte of lo word }
  97.      call   @1                     { convert dh to ascii }
  98.      jmp    @2
  99.  
  100.    @1:
  101.      mov    al, dh                 { 1 byte }
  102.      and    al, 0fh                { low nybble }
  103.      add    al, 90h
  104.      daa
  105.      adc    al, 40h
  106.      daa
  107.      mov    ah, al                 { store }
  108.      mov    al, dh                 { 1 byte }
  109.      shr    al, cl                 { get high nybble }
  110.      add    al, 90h
  111.      daa
  112.      adc    al, 40h
  113.      daa
  114.      stosw                         { move characters to result }
  115.      retn                          { return near }
  116.    @2:
  117.   end;
  118.  
  119. begin
  120.   Writeln( Hexlong($1234ABCD) );
  121. end.
  122. ---
  123.  ■ SLMR 2.1a ■ doesn't take a rocket scientist to be a rocket scientist
  124.  ■ KMail 3.00d Twin Peaks (303)-651-0225 ■ Home of KMail ■
  125.  ■ RNET 2.00b: ■ Twin Peaks BBS ■ (303)-651-0225, Longmont, Co.
  126.  * The DC Information Exchange (703)836-0748
  127.  * PostLink(tm) v1.07  DCINFO (#16) : MetroLink(tm)
  128.